home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / 12b.c < prev    next >
C/C++ Source or Header  |  1996-01-30  |  40KB  |  1,234 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* chapter 12, part b */
  10.  
  11. #include "hdr.h"
  12. #include "vars.h"
  13. #include "libp.h"
  14. #include "librp.h"
  15. #include "miscp.h"
  16. #include "smiscp.h"
  17. #include "dclmapp.h"
  18. #include "sspansp.h"
  19. #include "errmsgp.h"
  20. #include "nodesp.h"
  21. #include "setp.h"
  22. #include "chapp.h"
  23.  
  24. static void update_one_entry(Symbol, Symbol, Symbolmap);
  25. static void update_scalar_signature(Symbol, Symbol);
  26. static void update_record_entry(Symbol, Symbol, Symbolmap);
  27. static void update_array_entry(Symbol, Symbol, Symbolmap);
  28. static Node update_new_node(Node);
  29. static Symbol update_new_name(Symbolmap, Symbol);
  30. static void instantiate_derived_types(Node, Symbolmap);
  31. static Set update_overloads(Set, Symbolmap);
  32. static int check_recursive_instance(Node);
  33. static int scan_instance(Node);
  34. static void nodemap_free(Nodemap);
  35. static Node nodemap_get(Nodemap, Node);
  36. static void nodemap_put(Nodemap, Node, Node);
  37.  
  38. void instantiate_subprog_tree(Node node, Symbolmap type_map)
  39.   /*;instantiate_subprog_tree*/
  40. {
  41.     /* Build  the tree  for the instantiated object,  and the corresponding
  42.      * symbol table entries, some of which    may contain pointers to new tree.
  43.      */
  44.  
  45.     Node    id_node, gen_node, b_node, specs_node;
  46.     Symbol    prog_name, gen_name, g_p, new_p;
  47.     /* Nodemap    node_map; */
  48.     Tuple    sig, itup, packs;
  49.     Node    stmts_node, decl_node, handler_node;
  50.     Symbolmap    rename_map;
  51.     Tuple    truly_renamed;
  52.     Fortup      ft1;
  53.  
  54.     id_node   = N_AST1(node);
  55.     gen_node  = N_AST2(node);
  56.     prog_name = N_UNQ(id_node);
  57.     gen_name  = N_UNQ(gen_node);
  58.     /* instantiate all entities local to the subprogram. The type map is aug-
  59.      * mented with the mapping of local generic entities into their instances
  60.      */
  61.  
  62.     itup = instantiate_symbtab(gen_name, prog_name, type_map);
  63.     rename_map = (Symbolmap) itup[1];
  64.     packs = (Tuple)itup[2];
  65.     truly_renamed = (Tuple) itup[3];
  66.     /* Now use this mapping to instantiate the AST itself. */
  67.     node_map = nodemap_new();        /* global object. */
  68.     current_node = node;
  69.  
  70.     sig = SIGNATURE(gen_name);
  71.     b_node = (Node) sig[3];
  72.  
  73.     retrieve_generic_tree(b_node, (Node)0);    /* if in another file. */
  74.     /* Instantiate body and transform into subprogram node*/
  75.     specs_node   = N_AST1(b_node);
  76.     decl_node    = N_AST2(b_node);
  77.     stmts_node   = N_AST3(b_node);
  78.     handler_node = N_AST4(b_node);
  79.  
  80.     N_KIND(node) = as_subprogram;
  81.     N_AST1(node) = instantiate_tree(specs_node,   rename_map);
  82.     N_AST2(node) = instantiate_tree(decl_node,    rename_map);
  83.     N_AST3(node) = instantiate_tree(stmts_node,   rename_map);
  84.     N_AST4(node) = instantiate_tree(handler_node, rename_map);
  85.     /* Finally, complete the instantiation of the  symbol table. The later
  86.      * happens after  tree instantiation, to insure that symbtab instances 
  87.      * point to the instantiated nodes. The entry for the instance has been
  88.      * constructed by chain_overloads, and is not updated further.
  89.      */
  90.     truly_renamed = tup_with(truly_renamed, (char *) gen_name);
  91.     update_symbtab_nodes(rename_map, truly_renamed);
  92.  
  93.     /* Update the private declarations of enclosed packages */
  94.     FORTUP(g_p=(Symbol), packs, ft1);
  95.         new_p = symbolmap_get(rename_map, g_p);
  96.         private_decls(new_p) = (Set) update_private_decls(g_p, rename_map);
  97.     ENDFORTUP(ft1);
  98.     instantiate_derived_types(decl_node, rename_map);
  99.  
  100.     /*TBSL: should we free old node_map???    ds 7nov */
  101.     nodemap_free(node_map);        /* free current allocation */
  102.     node_map = nodemap_new();    /* discard after use. */
  103. }
  104.  
  105. void instantiate_pack_tree(Node node, Symbolmap type_map,
  106.   Tuple instance_list) /*;instantiate_pack_tree*/
  107. {
  108.     /* Build tree for  instantiated object, and symbol table entries for all
  109.      * its local entities. In the case of a forward instantiation, visibility
  110.      * rules  require that the symbol  table  of the visible  part    be  fully
  111.      * instantiated. The expander then instantiates the  symbol table for the
  112.      * body, together with the corresponding tree.
  113.      */
  114.     Node    id_node, gen_node;
  115.     Symbol    package, gen_name, g_p, new_p, new_f, sym, gen_formal, over;
  116.     /* Nodemap    node_map; */
  117.     Tuple    sig;
  118.     Node    priv_node, decl_node, b_node, spec_node, new_decl_node;
  119.     Node    new_priv_node;
  120.     Node    new_b_node;
  121.     Symbolmap    rename_map;
  122.     Tuple    ltup, itup, truly_renamed;
  123.     Tuple    packs, gen_tup, gen_list;
  124.     Fortup    ft1, ft2;
  125.     Forset    fs1, fs2;
  126.     Set      overloadables;
  127.     id_node = N_AST1(node);
  128.     gen_node = N_AST2(node);
  129.     package     = N_UNQ(id_node);
  130.     gen_name = N_UNQ(gen_node);
  131.  
  132.     /* Instantiate all entities local to the package. */
  133.     itup = instantiate_symbtab(gen_name, package, type_map);
  134.     rename_map = (Symbolmap)itup[1];
  135.     packs = (Tuple)itup[2];
  136.     truly_renamed = (Tuple) itup[3];
  137.     tup_free(itup); /* itup just used to pass result*/
  138.     /* Now instantiate the AST itself, and complete the instantiation of the
  139.      * symbol table. 
  140.      */
  141.     node_map = nodemap_new();            /* global object.*/
  142.     current_node = node;
  143.     sig = SIGNATURE(gen_name);
  144.     decl_node = (Node) sig[2];
  145.     priv_node = (Node) sig[3];
  146.     retrieve_generic_tree(decl_node, priv_node);
  147.     b_node = (Node) sig[4];
  148.     spec_node = node_new(as_package_spec);
  149.     new_decl_node = instantiate_tree(decl_node, rename_map);
  150.     new_priv_node = instantiate_tree(priv_node, rename_map);
  151.     /* N_LIST(new_decl_node) = instance_list + N_LIST(new_decl_node); */
  152.     N_LIST(new_decl_node) = tup_add(instance_list, N_LIST(new_decl_node));
  153.     N_AST1(spec_node) = id_node;
  154.     N_AST2(spec_node) = new_decl_node;
  155.     N_AST3(spec_node) = new_priv_node;
  156.     if (b_node != OPT_NODE) { /* Instantiate body as well */
  157.         retrieve_generic_tree(b_node, (Node)0);
  158.         new_b_node = instantiate_tree(b_node, rename_map);
  159.         N_KIND(new_b_node) = as_package_body;
  160.     }
  161.     else {
  162.         new_b_node = copy_node(node);
  163.         /* Attach tpe_map to node for eventual code emission */
  164.         ltup = tup_new(2);
  165.         ltup[1] = (char *) rename_map;
  166.         ltup[2] = (char *) needs_body(gen_name);
  167.         N_AST4(new_b_node) = new_instance_node(ltup);
  168.     }
  169.     /* In any case, emit the spec node before the body */
  170.     make_insert_node(node, tup_new1((char *) spec_node), new_b_node);
  171.  
  172.     /* Node references in the symbol table must point to the instantiated
  173.      * tree.
  174.      */
  175.     update_symbtab_nodes(rename_map, truly_renamed);
  176.  
  177.     /* Complete construction of visibility information for inner packages.    */
  178.     FORTUP(g_p=(Symbol), packs, ft1);
  179.         new_p = symbolmap_get(rename_map, g_p);
  180.         /* construct visible map for it, so that the proper instantiated
  181.          * entities within new package become accessible.
  182.          */
  183.         /* TBSL: review translation of next line */
  184.         /* 
  185.          *  visible(new_p) := { [id, symbolmap_get(rename_map, old_n) ? old_n] : 
  186.          *         [id, old_n] in  visible(g_p)};
  187.          */
  188.  
  189.         /*    
  190.          * Nested packages (which are not generic) are now visible: their
  191.          * local entities are nameable using qualified names.
  192.          */
  193.         if (NATURE(g_p) != na_generic_package
  194.             && NATURE(g_p) != na_generic_package_spec) {
  195.             vis_mods = tup_with(vis_mods, (char *) new_p);
  196.         }
  197.         /*
  198.          *The top level package is added to vis_mods in end_specs, called
  199.          * at the end of package_instance.
  200.          */
  201.         /* Finally, apply renamings to the private declarations. */
  202.         private_decls(new_p) = (Set) update_private_decls(g_p, rename_map);
  203.     ENDFORTUP(ft1);
  204.  
  205.     instantiate_derived_types(decl_node, rename_map);
  206.     /* The instantiation does not include a copy of the generic part. RM 12.3(5)
  207.      * Thus, the instantiation of the generic parameters themselves, is not
  208.      * visible. If, however, a generic subprogram parameter has an overload in
  209.      * the visible part of the package, that overload itself must remain
  210.      * accessible; so we just remove the name of the instantiated generic
  211.      * subprogram parameter from its own overloads set.
  212.      */
  213.     overloadables = set_new(0);
  214.     gen_list = (Tuple) SIGNATURE(gen_name)[1];
  215.     FORTUP(gen_tup = (Tuple), gen_list, ft2);
  216.         gen_formal = (Symbol) gen_tup[1];
  217.         new_f = symbolmap_get(rename_map, gen_formal);
  218.         if (new_f == (Symbol) 0)     /* error in instantiation */
  219.             /* TBSL: can we just return here ? */
  220.             continue;
  221.         if (NATURE(gen_formal)==na_procedure || NATURE(gen_formal)==na_function)
  222.             overloadables = set_with(overloadables, (char *) new_f);
  223.     ENDFORTUP(ft2);
  224.  
  225.     FORSET(sym=(Symbol), overloadables, fs1);
  226.         FORSET(over = (Symbol), overloadables, fs2);
  227.             if (set_mem((char *) over, OVERLOADS(sym)))
  228.                 OVERLOADS(sym) = set_del(OVERLOADS(sym), (char *) over);
  229.         ENDFORSET(fs2);
  230.     ENDFORSET(fs1);
  231. }
  232.  
  233. Tuple instantiate_symbtab(Symbol gen_name, Symbol new_n, Symbolmap rename_map)
  234.   /*;instantiate_symbtab*/
  235. {
  236.     /* This     procedure constructs  the symbol  table for instantiated  units.
  237.      * This involves the  instantiation of local entities. Constructing their
  238.      * symbol table     entries is akin  to assigning "locations" for them. Such
  239.      * locations also have    to be created  for  instantiated 'in' parameters.
  240.      * but not for types, or inout parameters, which are  simply renamings.
  241.      * On the other hand, generic subprogram parameters are already defined as
  242.      * renamings and the instantiation provides the name of the entity which
  243.      * they actually rename.  Finally, thediscriminants of generic
  244.      * private  types are  mapped into  the discriminants  of the  actuals by
  245.      * renaming also, and are not otherwise instantiated.
  246.      * The mapping rename_map is expanded by this  procedure, and used at the
  247.      * point of call to complete instantiation of the bodies.
  248.      */
  249.  
  250.     Tuple    gen_list, rtup;
  251.     Symbol    n;
  252.     Tuple    renamed_params, packs;
  253.     Symbol    gen_d;
  254.     Tuple    instantiated_scopes;
  255.     Symbol    g_n;
  256.     Symbol    new_pn;
  257.     Declaredmap old_decls, new_decls;
  258.     char    *id;
  259.     Symbol    old_n;
  260.     int        nat;
  261.     Fordeclared fd1;
  262.     Tuple    workpile, tup;
  263.     Forsymbol    fsym;
  264.     Fortup    ft1;
  265.  
  266.  
  267.     tup = SIGNATURE(gen_name);
  268.     gen_list= (Tuple) tup[1];
  269.  
  270.     /*renamed_params := { n : [n, -] in gen_list | NATURE(n) != na_in} +
  271.      * {gen_d : [gen_d, -] in rename_map | nature(gen_d) = na_discriminant};
  272.      */
  273.     renamed_params = tup_new1((char *) new_n);
  274.     FORTUP(tup=(Tuple), gen_list, ft1);
  275.         n = (Symbol) tup[1];
  276.         nat = NATURE(n);
  277.         if (nat != na_in && nat != na_procedure && nat != na_function) {
  278.             if (!tup_mem((char *) n, renamed_params))
  279.                 renamed_params = tup_with(renamed_params, (char *) n);
  280.         }
  281.     ENDFORTUP(ft1);
  282.     FORSYMBOL(gen_d, n, rename_map, fsym);
  283.         nat = NATURE(gen_d);
  284.         if (nat == na_discriminant) {
  285.             if (!tup_mem( (char *) gen_d, renamed_params))
  286.                 renamed_params = tup_with(renamed_params, (char *) gen_d);
  287.         }
  288.         else if (nat == na_in || nat == na_function || nat == na_procedure) {
  289.             /* set scope of instantiated parameters to the instantiated unit */
  290.             SCOPE_OF(n) = new_n;
  291.         }
  292.     ENDFORSYMBOL(fsym);
  293.     /* Create the proper prefix for the unique names of instantiated entities */
  294. #ifdef TBSN
  295. o_pref :
  296.     = prefix;
  297. prefix :
  298.     = original_name(new_n) + '.';
  299. #endif
  300.     /* An additional complication has to do with nested declarations(records,
  301.      * other packages) within the  generic object.    For these  we  must  also
  302.      * create  instances of     their symbol  tables, so that type  checking of
  303.      * their  uses can  be performed.  We therefore     traverse recursively all
  304.      * nested declarations within the generic object, to collect every object
  305.      * whose symbol     table field  must be  instantiated.  This may be done at
  306.      * generic definition  time, and  will    be more efficient  than here. For
  307.      * procedures and  functions, only  their signature is needed  to perform
  308.      * type-checking, but their  symbol  tables are instantiated as well, for
  309.      * completeness and for use by the code generator.
  310.     */
  311.  
  312.     packs = tup_new(0); /* to collect names of nested packages. */
  313.     instantiated_scopes = tup_new(0);  /* All of which have declared maps.*/
  314.     tup = tup_new(2);
  315.     tup[1] = (char *) gen_name;
  316.     tup[2] = (char *) new_n;
  317.     workpile = tup_new1((char *) tup);
  318.     while (tup_size(workpile)) {
  319.         tup = (Tuple) tup_frome(workpile);
  320.         g_n = (Symbol) tup[1];
  321.         new_pn = (Symbol) tup[2];
  322.         tup_free(tup);
  323.         if (!tup_mem((char *) g_n, instantiated_scopes)) {
  324.             instantiated_scopes =tup_with(instantiated_scopes, (char *) g_n);
  325.         }
  326.         if (cdebug2 > 3) TO_ERRFILE("Instantiating scope " );
  327.  
  328.         /* Iterate over all items declared in g_n, the generic object (or any
  329.             * object nested within and which has declarations : package, record,
  330.             * subprogram, task) and collect declarations for instantiated items.
  331.             */
  332.  
  333.         old_decls = DECLARED(g_n);
  334.         new_decls = dcl_new(0);
  335.  
  336.         FORDECLARED(id, old_n, old_decls, fd1);
  337.             if (cdebug2 > 0) TO_ERRFILE("     Instantiating item ");
  338.  
  339.             if (tup_mem((char *)old_n, renamed_params)){
  340.                 /*
  341.                    * generic parameter which was renamed already. 
  342.                    */
  343.                 n = symbolmap_get(rename_map, old_n);
  344.                 if (n != (Symbol)0)
  345.                     /* will be Symbol 0 ONLY if there was an error, in which
  346.                      * case we do not put it in the declared map !
  347.                      */
  348.                     dcl_put_vis(new_decls, id, n, IS_VISIBLE(fd1));
  349.                     if (REPR(n) != (Tuple)0) {
  350.                        REPR(old_n) = REPR(n);
  351.                     }
  352.             }
  353.             else if ((new_n = symbolmap_get(rename_map, old_n)) != (Symbol)0)
  354.                 /* id renames an object which has been instantiated already.
  355.                    * The instantiation of id will point to the instantiation of
  356.                    * that object.
  357.                    */
  358.                 dcl_put_vis(new_decls, id, new_n, IS_VISIBLE(fd1));
  359.             else if (SCOPE_OF(old_n) != g_n) {
  360.                 /* old_n is a renaming of some other entity, generic or other-
  361.                    * wise, which is defined in some outer scope. The instantia-
  362.                    * tion of old_n must rename the same entity.
  363.                    */
  364.                 if ((new_n = symbolmap_get(rename_map, old_n)) == (Symbol)0){
  365.                     symbolmap_put(rename_map, old_n, old_n);
  366.                     new_n = old_n;
  367.                     /*new_n = rename_map(old_n) := old_n;*/
  368.                 }
  369.                 if (!tup_mem((char *) old_n, renamed_params))
  370.                     renamed_params = tup_with(renamed_params, (char *) old_n);
  371.                 dcl_put_vis(new_decls, id, new_n, IS_VISIBLE(fd1));
  372.             }
  373.             else if (NATURE(old_n) != na_void) {
  374.                 new_n = sym_new(na_void);
  375.                 /* map generic to actual. */
  376.                 symbolmap_put(rename_map, old_n, new_n);
  377.                 /* Create entry in declared for instantiated item. Other symb
  378.                     * table fields are set in update_symbtab_info below.
  379.                     */
  380.                 NATURE(new_n) = NATURE(old_n);
  381.                 SCOPE_OF(new_n) = new_pn;
  382.                 if (REPR(old_n) != (Tuple)0) {
  383.                     REPR(new_n) = tup_copy(REPR(old_n));
  384.                 }
  385.                 dcl_put_vis(new_decls, id, new_n, IS_VISIBLE(fd1));
  386.                 if (SCOPE_OF(old_n) != old_n
  387.                    &&  DECLARED(old_n) != (Declaredmap)0
  388.                     /* an anonymous task type has a declared map, which is
  389.                    * instantiated when the corresponding single task object
  390.                    * is. That map should not be instantiated twice.
  391.                    */
  392.                   && !is_anonymous_task(old_n)){
  393.                     /* Nested record, package, subprogram, or task.
  394.                      * Put on workpile with appropriate prefix for new names.
  395.                      */
  396.                     tup = tup_new(2);
  397.                     tup[1] = (char *) old_n;
  398.                     tup[2] = (char *) new_n;
  399.                     workpile = tup_with(workpile, (char *) tup);
  400.                 }
  401.             }
  402.         ENDFORDECLARED(fd1);
  403.  
  404.         /* Assign new declarations to package, record or task entity. */
  405.  
  406.         DECLARED(new_pn) = new_decls;
  407.         nat = NATURE(g_n);
  408.  
  409.         if (nat  == na_package || nat == na_package_spec
  410.           || nat == na_generic_package
  411.           || nat == na_generic_package_spec){
  412.             if (!tup_mem((char *) g_n, packs))
  413.                 packs = tup_with(packs , (char *) g_n);
  414.         }
  415.     }
  416.  
  417. #ifdef TBSN
  418.     prefix = o_pref;                
  419.     $ Restore naming environment
  420. #endif
  421.     rtup = tup_new(3);
  422.     rtup[1] = (char *) rename_map;
  423.     rtup[2] = (char *) packs;
  424.     rtup[3] = (char *) renamed_params;
  425.     return rtup;
  426. }
  427.  
  428. void update_symbtab_nodes(Symbolmap rename_map, Tuple truly_renamed)
  429.   /*;update_symbtab_nodes*/
  430. {
  431.     /*
  432.      * The rename_map  contains  the generic  items and the names of their
  433.      * instantiations. We  must  now complete the symbol table entries for
  434.      * the later,  to insure  that    type information  is correct. 
  435.      *
  436.      * Entities that are true renamings (generic types, inout parameters, or 
  437.      * actual renamings  within the generic     object)  have    no symbol  table 
  438.      * entry in it, and are skipped in what follows.
  439.      */
  440.  
  441.     Symbol    old_n, new_n;
  442.     Forsymbol    fsym;
  443.  
  444.     FORSYMBOL(old_n, new_n, rename_map, fsym);
  445.         if (!tup_mem((char *)old_n, truly_renamed) && TYPE_OF(new_n)==(Symbol)0)
  446.             update_one_entry(old_n, new_n, rename_map);
  447.     ENDFORSYMBOL(fsym);
  448. }
  449.  
  450. static void update_one_entry(Symbol old_n, Symbol new_n, Symbolmap rename_map)
  451.   /*;update_one_entry*/
  452. {
  453.     /* Update the symbol  table entry of one entity in an instantiated unit.
  454.      * The scope of the new entry has already been established. The node_map 
  455.      * (global) takes generic nodes into their instances.
  456.      */
  457.  
  458.     int        nat, ii, nn;
  459.     Tuple    tup, gen_list, form_list, new_gen_list, new_form_list, otup, ntup;
  460.     Node    body_node, decl_node, opt_priv_node, node, n, d;
  461.     Fortup    ft1;
  462.     Tuple    discr_map, newdiscr_map, newsig, constrain_list, new_constrain_list;
  463.  
  464.     /* SETL macros new_node and new_name are done using procedures 
  465.      * update_new_node and update_new_name, respectively.
  466.      */
  467.     TYPE_OF(new_n) = update_new_name(rename_map, TYPE_OF(old_n));
  468.     if (ALIAS(old_n) == symbol_discrete_type)
  469.         /* not in the rename map ! */
  470.         ALIAS(new_n) = root_type(TYPE_OF(new_n));
  471.     else 
  472.         ALIAS(new_n) = update_new_name(rename_map, ALIAS(old_n));
  473.  
  474.     ORIG_NAME(new_n) = ORIG_NAME(old_n);
  475.     /* The signature of  entities may  contain tree nodes (constraints, 
  476.      * initial values, etc). The instantiated entries must point to the
  477.      * corresponding instantiated node.
  478.      */
  479.     switch (nat = NATURE(old_n)) {
  480.     case na_constant:
  481.     case na_discriminant:
  482.     case na_in:
  483.     case na_obj:
  484.         d = (Node) default_expr(old_n);
  485.         if (d != (Node)0) {
  486.             if (nat == na_in || nat == na_discriminant)
  487.                 /* default expression is not attached to generic tree, and
  488.                  * must be instantiated separately.
  489.                   */
  490.                 default_expr(new_n) = (Tuple)instantiate_tree(d, rename_map);
  491.             else
  492.                 default_expr(new_n) = (Tuple)update_new_node(d);
  493.         }
  494.         break;
  495.     case na_out:
  496.     case na_inout:
  497.         default_expr(new_n) = (Tuple)OPT_NODE;
  498.         break;
  499.     case na_type:
  500.         if (is_scalar_type(old_n))
  501.             update_scalar_signature(old_n, new_n);
  502.         else if (in_incp_types(TYPE_OF(root_type(old_n)) )) {
  503.             update_record_entry(old_n, new_n, rename_map);
  504.             misc_type_attributes(new_n) = misc_type_attributes(old_n);
  505.         }
  506.         break;
  507.     case na_subtype:
  508.         if (is_scalar_type(old_n))
  509.             update_scalar_signature(old_n, new_n);
  510.         else if (is_array(old_n))
  511.             update_array_entry(old_n, new_n, rename_map);
  512.         else if (is_record(old_n)) {
  513.             tup = SIGNATURE(old_n);
  514.             discr_map = (Tuple) numeric_constraint_discr(tup);
  515.             newsig = tup_new(2);
  516.             numeric_constraint_kind(newsig) = (char *) CONSTRAINT_DISCR;
  517.             nn = tup_size(discr_map);
  518.             newdiscr_map = tup_new(nn);
  519.             for (ii = 1; ii <= nn; ii+=2) {
  520.                 newdiscr_map[ii] = (char *) update_new_name(rename_map,
  521.                   (Symbol) discr_map[ii]);
  522.                 newdiscr_map[ii+1] = 
  523.                   (char *) update_new_node((Node)discr_map[ii+1]);
  524.             }
  525.             numeric_constraint_discr(newsig) = (char *) newdiscr_map;
  526.             SIGNATURE(new_n) = newsig;
  527. #ifdef TBSL
  528.             -- status of this is undecided
  529.                 misc_type_attributes(new_n) = misc_type_attributes(old_n);
  530. #endif
  531.         }
  532.         else if (is_access(old_n)) {
  533.             newsig = constraint_new(CONSTRAINT_ACCESS);
  534.             newsig[2] = 
  535.               (char *)update_new_name(rename_map, designated_type(old_n));
  536.             SIGNATURE(new_n) = newsig;
  537.         }
  538.         break;
  539.     case na_enum:
  540.         update_scalar_signature(old_n, new_n);
  541.         /*(literal_map(new_n) := {[new_name(l), i]:
  542.          * [l, i] in literal_map(old_n)};
  543.          */
  544.         otup = (Tuple) literal_map(old_n);
  545.         if (otup != (Tuple)0) {
  546.             nn = tup_size(otup);
  547.             ntup = tup_new(nn);
  548.             for (ii = 1; ii <= nn; ii+=2) {
  549.                 ntup[ii] = (char *)update_new_name(rename_map,(Symbol)otup[ii]);
  550.                 ntup[ii+1] = otup[ii+1];
  551.             }
  552.         }
  553.         else {
  554.             ntup = otup;
  555.         }
  556.         literal_map(new_n) = (Set) ntup;
  557.         break;
  558.     case na_record:
  559.         update_record_entry(old_n, new_n, rename_map);
  560.         break;
  561.     case na_array:
  562.         update_array_entry(old_n, new_n, rename_map);
  563.         break;
  564.     case na_procedure:
  565.     case na_procedure_spec:
  566.     case na_function:
  567.     case na_function_spec:
  568.     case na_literal:
  569.     case na_entry:
  570.         /*signature(new_n) := [new_name(f): f in signature(old_n)];*/
  571.         otup = SIGNATURE(old_n);
  572.         if (otup != (Tuple)0) {
  573.             nn =tup_size(otup);
  574.             ntup = tup_new(nn);
  575.             for (ii = 1; ii <= nn; ii++)
  576.                 ntup[ii] = (char *)update_new_name(rename_map,(Symbol)otup[ii]);
  577.             SIGNATURE(new_n) = ntup;
  578.         }
  579.         OVERLOADS(new_n) = update_overloads(OVERLOADS(old_n), rename_map);
  580.         break;
  581.     case na_entry_former:
  582.     case na_entry_family:
  583.         otup = SIGNATURE(old_n);
  584.         if (otup != (Tuple)0) {
  585.             nn = tup_size(otup);
  586.             ntup = tup_new(nn);
  587.             for (ii = 1; ii <= nn; ii++)
  588.                 ntup[ii] = (char *)update_new_name(rename_map,(Symbol)otup[ii]);
  589.             SIGNATURE(new_n) = ntup;
  590.         }
  591.         break;
  592.     case na_generic_procedure:
  593.     case na_generic_procedure_spec:
  594.     case na_generic_function:
  595.     case na_generic_function_spec:
  596.         tup = SIGNATURE(old_n);
  597.         gen_list = (Tuple) tup[1];
  598.         form_list = (Tuple) tup[2];
  599.         body_node = (Node) tup[3];
  600.         constrain_list = (Tuple) tup[4];
  601.         /* new_gen_list := [[update_new_name(rename_map, n), 
  602.          *             update_new_node(node_map, node)]
  603.          *        : [n, node] in gen_list];
  604.          */
  605.         nn = tup_size(gen_list);
  606.         new_gen_list = tup_new(nn);
  607.         FORTUPI(tup=(Tuple), gen_list, ii, ft1);
  608.             n = (Node) tup[1]; 
  609.             node = (Node) tup[2];
  610.             tup =tup_new(2);
  611.             tup[1]= (char *) update_new_name(rename_map, (Symbol) n);
  612.             tup[2] = (char *) update_new_node(node);
  613.             new_gen_list[ii] = (char *) tup;
  614.         ENDFORTUP(ft1);
  615.         /*new_form_list := [replace(n, rename_map): n in form_list];*/
  616.         nn = tup_size(form_list);
  617.         new_form_list = tup_new(nn);
  618.         for (ii = 1; ii <= nn; ii++)
  619.             new_form_list[ii] = 
  620.               (char *) replace((Symbol) form_list[ii], rename_map);
  621.         /*new_constrain_list := [replace(n, rename_map): n in constrain_list];*/
  622.         nn = tup_size(constrain_list);
  623.         new_constrain_list = tup_new(nn);
  624.         for (ii = 1; ii <= nn; ii++)
  625.             new_form_list[ii] = 
  626.               (char *) replace((Symbol) constrain_list[ii], rename_map);
  627.         tup = tup_new(4);
  628.         tup[1] = (char *) new_gen_list;
  629.         tup[2] = (char *) new_form_list;
  630.         tup[3] = (char *) update_new_node(body_node);
  631.         tup[4] = (char *) new_constrain_list;
  632.         SIGNATURE(new_n) = tup;
  633.         break;
  634.     case na_task_obj:
  635.     case na_task_obj_spec:
  636.         /* declared map (entry names) is shared with anonymous task type.*/
  637.         DECLARED(TYPE_OF(new_n)) = DECLARED(new_n);
  638.         break;
  639.     case na_generic_package:
  640.     case na_generic_package_spec:
  641.         tup = SIGNATURE(old_n);
  642.         gen_list = (Tuple) tup[1];
  643.         decl_node = (Node) tup[2];
  644.         opt_priv_node = (Node) tup[3];
  645.         body_node = (Node) tup[4];
  646.         constrain_list = (Tuple) tup[5];
  647.         /* new_gen_list := [[update_new_name(rename_map, n), 
  648.          *             update_new_node(node_map, node)]
  649.          *        : [n, node] in gen_list];
  650.          */
  651.         nn = tup_size(gen_list);
  652.         new_gen_list = tup_new(nn);
  653.         FORTUPI(tup=(Tuple), gen_list, ii, ft1);
  654.             n = (Node) tup[1]; 
  655.             node = (Node) tup[2];
  656.             tup =tup_new(2);
  657.             tup[1]= (char *) update_new_name(rename_map, (Symbol) n);
  658.             tup[2] = (char *) update_new_node(node);
  659.             new_gen_list[ii] = (char *) tup;
  660.         ENDFORTUP(ft1);
  661.         /*new_constrain_list := [replace(n, rename_map): n in constrain_list];*/
  662.         nn = tup_size(constrain_list);
  663.         new_constrain_list = tup_new(nn);
  664.         for (ii = 1; ii <= nn; ii++)
  665.             new_form_list[ii] = 
  666.               (char *) replace((Symbol) constrain_list[ii], rename_map);
  667.         tup = tup_new(5);
  668.         tup[1] = (char *) new_gen_list;
  669.         tup[2]= (char *) update_new_node(decl_node);
  670.         tup[3] = (char *) update_new_node(opt_priv_node);
  671.         tup[4] = (char *) update_new_node(body_node);
  672.         tup[5] = (char *) new_constrain_list;
  673.         SIGNATURE(new_n) = tup;
  674.         break;
  675.     case na_aggregate:
  676.         OVERLOADS(new_n) = update_overloads(OVERLOADS(old_n), rename_map);
  677.         break;
  678.     case na_access:
  679.         /* update designated type */
  680.         SIGNATURE(new_n) = 
  681.           (Tuple) update_new_name(rename_map, designated_type(old_n));
  682.         OVERLOADS(new_n) = update_overloads(OVERLOADS(old_n), rename_map);
  683.         break;
  684.     }
  685.     /* verify all uses of signature and overloads are covered*/
  686. }
  687.  
  688. static void update_scalar_signature(Symbol old_n, Symbol new_n)
  689.   /*update_scalar_signature*/
  690. {
  691.     Tuple  otup,  ntup;
  692.     Symbol old_base, new_base;
  693.  
  694.     old_base = base_type(old_n);
  695.     new_base = TYPE_OF(new_n);
  696.     otup = SIGNATURE(old_n);
  697.     if (otup != (Tuple)0) {
  698.         ntup = tup_new(tup_size(otup));
  699.         numeric_constraint_kind(ntup) = numeric_constraint_kind(otup);
  700.         numeric_constraint_low(ntup)  = (char *) update_new_node
  701.           ((Node)numeric_constraint_low(otup));
  702.         numeric_constraint_high(ntup) = (char *) update_new_node
  703.           ((Node)numeric_constraint_high(otup));
  704.  
  705.         if ((int)numeric_constraint_kind(otup) == CONSTRAINT_DIGITS) {
  706.             if (is_generic_type(old_base)
  707.               && N_KIND((Node)numeric_constraint_digits(otup)) != as_ivalue)
  708.                 /* inherit digits from generic actual */
  709.                 numeric_constraint_digits(ntup) = 
  710.                   numeric_constraint_digits(SIGNATURE(new_base));
  711.             else
  712.                 numeric_constraint_digits(ntup)=numeric_constraint_digits(otup);
  713.         }
  714.         else if ((int)numeric_constraint_kind(otup) == CONSTRAINT_DELTA) {
  715.             if (is_generic_type(old_base)
  716.               && N_KIND((Node)numeric_constraint_delta(otup)) != as_ivalue) {
  717.                 /* inherit  generic and small from actual */
  718.                 numeric_constraint_delta(ntup) = 
  719.                   numeric_constraint_delta(SIGNATURE(new_base));
  720.                 numeric_constraint_small(ntup) = 
  721.                   numeric_constraint_small(SIGNATURE(new_base));
  722.             }
  723.             else {
  724.                 numeric_constraint_delta(ntup) = numeric_constraint_delta(otup);
  725.                 numeric_constraint_small(ntup) = numeric_constraint_small(otup);
  726.             }
  727.         }
  728.         SIGNATURE(new_n) = ntup;
  729.     }
  730. }
  731.  
  732. static void update_record_entry(Symbol old_n, Symbol new_n,Symbolmap rename_map)
  733.   /*;update_record_entry*/
  734. {
  735.     Node i_node , v_node;
  736.     Tuple sig, old_disc_list, new_disc_list;
  737.     int  i, disc_size;
  738.  
  739.     sig = record_declarations(new_n) = tup_new(5);
  740.     i_node = (Node) invariant_part(old_n);
  741.     v_node = (Node) variant_part(old_n);
  742.     sig[1] = (char *) update_new_node(i_node);   /* invariant_part */
  743.     sig[2] = (char *) update_new_node(v_node);   /* variant_part */
  744.     sig[4] = (char *) DECLARED(new_n);           /* declared_components */
  745.     old_disc_list = (Tuple) discriminant_list(old_n);
  746.     disc_size = tup_size(old_disc_list);
  747.     new_disc_list = tup_new(disc_size);
  748.     sig[3] = (char *) new_disc_list;          /* discriminant_list */
  749.     for (i = 1; i <= disc_size; i++)
  750.         new_disc_list[i] = 
  751.           (char *) update_new_name(rename_map, (Symbol)old_disc_list[i]);
  752. #ifdef TBSL
  753.     misc_type_attributes(new_n) = misc_type_attributes(old_n);
  754. #endif
  755. }
  756.  
  757. static void update_array_entry(Symbol old_n, Symbol new_n, Symbolmap rename_map)
  758.   /*;update_array_entry */
  759. {
  760.     Tuple newsig, tup;
  761.     Symbol si;
  762.     int i;
  763.     Fortup  ft;
  764.  
  765.     /*index_types(new_n) := [new_name(i) : i in index_types(old_n)];*/
  766.     SIGNATURE(new_n) = newsig = tup_new(2);
  767.         tup = tup_new(tup_size(index_types(old_n)));
  768.     FORTUPI(si=(Symbol), (Tuple)index_types(old_n), i, ft);
  769.         tup[i] = (char *) update_new_name(rename_map, si);
  770.     ENDFORTUP(ft);
  771.     newsig[1] = (char *) tup;                 /* index_types */
  772.     newsig[2] = (char *) update_new_name(rename_map,
  773.       component_type(old_n));  /* component_type */
  774. #ifdef TBSL
  775.     misc_type_attributes(new_n) = misc_type_attributes(old_n);
  776. #endif
  777. }
  778.  
  779. static Node update_new_node(Node n)        /*;update_new_node*/
  780. {
  781.     /* transcription of macro new_node in update_one_entry */
  782.     Node    t;
  783.  
  784.     t = nodemap_get(node_map, n);
  785.     if (t == (Node)0) t = n;
  786.     return t;
  787. }
  788.  
  789. static Symbol update_new_name(Symbolmap nmap, Symbol s)        /*;update_new_name*/
  790. {
  791.     /* transcription of macro new_name in update_one_entry */
  792.     Symbol    t;
  793.  
  794.     t = symbolmap_get(nmap, s);
  795.     if (t == (Symbol)0) t = s;
  796.     return t;
  797. }
  798.  
  799. static void instantiate_derived_types(Node decl_node, Symbolmap rename_map)
  800.   /*;instantiate_derived_types*/
  801. {
  802.     /* derived type declarations whose parent type is a generic type must be
  803.      * reprocessed, in order to complete the derivation of subprograms from
  804.      * the instance of the generic formal (AI 398).
  805.      */
  806.  
  807.     Symbol gen_p, gen_d, act_p, act_d, act_dt;
  808.     Node   n1, n2;
  809.     Fortup ft1;
  810.  
  811.     FORTUP(n1=(Node), N_LIST(decl_node), ft1)
  812.         if (N_KIND(n1) == as_type_decl) n2 = N_AST3(n1);
  813.         else if (N_KIND(n1) == as_subtype_decl) n2 = N_AST2(n1);
  814.         else continue;
  815.  
  816.         if (N_KIND(n2) == as_derived_type) {
  817.             gen_d = N_UNQ(N_AST1(n1));         /* derived type in template */
  818.             gen_p = N_UNQ(N_AST1(N_AST1(n2))); /* parent  type in template */
  819.             if (is_generic_type(gen_p) && SCOPE_OF(gen_d) == SCOPE_OF(gen_p))
  820.             {
  821.                 act_d = update_new_name(rename_map, gen_d);
  822.                 act_p = update_new_name(rename_map, gen_p);
  823.  
  824.                 if (NATURE(gen_d) == na_type && NATURE(act_p) == na_subtype) {
  825.                     /* if formal has no constraint, but actual is a subtype,
  826.                      * must first derive anonymous type, of which the
  827.                      * instantiation of the name appearing in the type
  828.                      * declaration is a subtype.
  829.                        */
  830.                     act_dt = sym_new(na_void);    /*anonymous derived type */
  831.                     dcl_put_vis(DECLARED(scope_name),newat_str(), act_dt, TRUE);
  832.                     NATURE(act_d)  = na_subtype;
  833.                     TYPE_OF(act_d) = act_dt;
  834.                 }
  835.                 else
  836.                     act_dt = base_type(act_d);
  837.                 ALIAS(act_d)     = ALIAS(act_p);
  838.                 SIGNATURE(act_d)  = SIGNATURE(act_p);
  839.                 SIGNATURE(act_dt) = SIGNATURE(act_p);
  840.                 /* For now do not create derived programs. */
  841.                 /*  build_derived_type(act_p, act_dt, current_node); */
  842.             }
  843.         }
  844.     ENDFORTUP(ft1);
  845. }
  846.  
  847. static Set update_overloads(Set oset, Symbolmap rename_map)
  848.   /*;update_overloads*/
  849. {
  850.     Set nset;
  851.     Forset fs1;
  852.     Symbol si;
  853.  
  854.     nset = (Set)0;
  855.     if (oset != (Set)0) {
  856.         nset = set_new(set_size(oset));
  857.         FORSET(si=(Symbol), oset, fs1);
  858.             nset = set_with(nset, (char *) update_new_name(rename_map, si));
  859.         ENDFORSET(fs1);
  860.     }
  861.     return nset;
  862. }
  863.  
  864. Private_declarations update_private_decls(Symbol pack_name,
  865.   Symbolmap rename_map)                             /*;update_private_decls*/
  866. {
  867.     /* Complete the instantiation of the private declarations of a package.
  868.      * The    same renaming rules apply as  for visible symbol table entries.
  869.      * We install each private declaration in the  symbol table, update the
  870.      * information, and swap back.
  871.      */
  872.  
  873.     Private_declarations  old_decls, new_decls;
  874.     Forprivate_decls    fp;
  875.     Symbol    old_n, info, new_n, save_new;
  876.  
  877.     new_decls = private_decls_new(0);
  878.     /* TBSL:
  879.      * -- this involves more than swapping, need to copy entries as appropiate
  880.      * -- ds  9 nov 84
  881.     */
  882.  
  883.     /*(forall [old_n, info] in private_decls(pack_name))*/
  884.     old_decls = (Private_declarations) private_decls(pack_name);
  885.     FORPRIVATE_DECLS(old_n, info, old_decls, fp);
  886.         new_n = symbolmap_get(rename_map, old_n);
  887.         if (new_n == (Symbol)0)  continue;    /* some error. */
  888.  
  889. #ifdef TBSN
  890. [save_old, save_new] :
  891.     = [SYMBTABF(old_n), SYMBTABF(new_n)];
  892.     SYMBTABF(old_n) :
  893.     = info;
  894. #endif
  895.         save_new = sym_new_noseq(na_void);
  896.         sym_copy(save_new, new_n);
  897.         update_one_entry(info, new_n, rename_map);
  898.         NATURE(new_n) = NATURE(info);  /* maybe different from visible decl */
  899.         SCOPE_OF(new_n)  = symbolmap_get(rename_map, pack_name);
  900. #ifdef TBSN
  901.     new_decls(new_n) :
  902.     = SYMBTABF(new_n);
  903. [SYMBTABF(old_n), SYMBTABF(new_n)] :
  904.     = [save_old, save_new];
  905. #endif
  906.         private_decls_put(new_decls, new_n);
  907.         sym_copy(new_n, save_new);
  908.     ENDFORPRIVATE_DECLS(fp);
  909.     return new_decls;
  910. }
  911.  
  912. Node instantiate_tree(Node node, Symbolmap rename_map) /*;instantiate_tree*/
  913. {
  914.     /*
  915.      * Makes a copy of the tree rooted at node, while replacing occurences
  916.      * of names in domain rename_map by corresponding values. If the
  917.      * instantiation contains an inner forward instantiation, the renaming 
  918.      * map of the inner one must be combined with the outer one. 
  919.      */
  920.  
  921.     Node    root;
  922.     Symbol    dnode, rnode;
  923.     Tuple    tup, ltup, ntup;
  924.     Symbolmap    new_r_map, r_map;
  925.     Forsymbol    fsym;
  926.     int        i, ni, n;
  927.     unsigned int nkind;
  928.     Node    anode, nnode;
  929.     Fortup    ft1;
  930.     Symbol    old_n, new_n;
  931.  
  932.     if (node == OPT_NODE ) return OPT_NODE;
  933.     nkind = N_KIND(node);
  934.     root = node_new(nkind);
  935.     /*N_VAL(root) = N_VAL(node);  very delicate code - 3-20-86  DS */
  936.     if (N_VAL_DEFINED(nkind)) N_VAL (root) = N_VAL (node);
  937.     if (is_terminal_node(nkind) && current_node != OPT_NODE)
  938.         copy_span(current_node, root);
  939.  
  940.     if (nkind == as_function_instance 
  941.       || nkind == as_procedure_instance 
  942.       || nkind == as_package_instance) {
  943.         /* Update the instantiation information.*/
  944.         tup = tup_copy((Tuple) N_VAL(N_AST4(node)));
  945.         r_map = (Symbolmap) tup[1];
  946.         /* TBSL: should set better size for new_r_map on init. alloc.*/
  947.         /*
  948.          * new_r_map := { [old_n, rename_map(new_n) ? new_n]:
  949.          *                [old_n, new_n] in r_map};
  950.          */
  951.         new_r_map = symbolmap_new();
  952.         FORSYMBOL(old_n, new_n, r_map, fsym);
  953.             symbolmap_put(new_r_map, old_n, replace(new_n, rename_map));
  954.         ENDFORSYMBOL(fsym);
  955.         /*N_VAL(root)  := [new_r_map, flag]; */
  956.         tup[1] = (char *) new_r_map;
  957.         N_AST4(root) = new_instance_node(tup);
  958.  
  959.         /* And check that no recursive instantiations are implied by
  960.          *  the current inner one.
  961.          */
  962.         check_recursive_instance(node);
  963.     }
  964.     /*N_UNQ (root) = symbolmap_get(rename_map, N_UNQ(node))  ? N_UNQ(node);*/
  965.     dnode = N_UNQ(node);
  966.     rnode = symbolmap_get(rename_map, dnode);
  967.     if (rnode == (Symbol)0) rnode = dnode;
  968.     if (nkind == as_array_aggregate || nkind == as_record_aggregate) {
  969.         /* the internally generated name of the aggregate is not in the
  970.          * symbol table, for delicate separate compilation reasons. Each
  971.          * aggregate instance must nevertheless have a distinct name
  972.          */
  973.         rnode = sym_new(na_void);
  974.     }
  975.     if (N_UNQ_DEFINED(N_KIND(root)))
  976.         N_UNQ(root) = rnode;
  977.     /*N_TYPE(root) := symbolmap_get(rename_map, N_TYPE(node)) ? N_TYPE(node);*/
  978.     dnode= N_TYPE(node);
  979.     rnode = symbolmap_get(rename_map, dnode);
  980.     if (rnode == (Symbol)0) rnode = dnode;
  981.     if (N_TYPE_DEFINED(N_KIND(root)))
  982.         N_TYPE(root) = rnode;
  983.     N_SIDE(root) = N_SIDE(node);
  984.     /* N_AST (root) := [instantiate_tree(n, rename_map): 
  985.      *     n in N_AST(node)  ? []];
  986.      */
  987.     for (ni = 1; ni <= 4; ni++) {
  988.         anode = (Node)0;
  989.         if (ni == 1 && N_AST1_DEFINED(nkind)) anode =N_AST1(node);
  990.         else if (ni == 2 && N_AST2_DEFINED(nkind)) anode = N_AST2(node);
  991.         else if (ni == 3 && N_AST3_DEFINED(nkind)) anode = N_AST3(node);
  992.         else if (ni == 4 && N_AST4_DEFINED(nkind)) {
  993.             anode = N_AST4(node);
  994.             if (N_KIND(anode) == as_instance_tuple) continue;
  995.             /* treated above as special case in instance nodes */
  996.         }
  997.         if (anode == (Node)0) continue;
  998.         nnode = instantiate_tree(anode, rename_map);
  999.         if (anode != (Node)0) {
  1000.             if (ni == 1) N_AST1(root) = nnode;
  1001.             else if (ni == 2) N_AST2(root) = nnode;
  1002.             else if (ni == 3) N_AST3(root) = nnode;
  1003.             else if (ni == 4) N_AST4(root) = nnode;
  1004.         }
  1005.     }
  1006.     if (N_LIST_DEFINED(nkind))
  1007.         ltup = N_LIST(node);
  1008.     else
  1009.         ltup = (Tuple)0;
  1010.     if (ltup != (Tuple)0) {
  1011.         /* N_LIST(root) := [instantiate_tree(n, rename_map): 
  1012.          *     n in N_LIST(node) ? []];
  1013.          */
  1014.         n = tup_size(ltup);
  1015.         ntup = tup_new(n);
  1016.         FORTUPI(nnode=(Node), ltup, i, ft1);
  1017.             ntup[i] = (char *)instantiate_tree(nnode, rename_map);
  1018.         ENDFORTUP(ft1);
  1019.         N_LIST(root) = ntup;
  1020.     }
  1021. /*
  1022.  * In the case of a slice, the procedure slice_type reformats the as_slice node.
  1023.  * The lower and upper bounds nodes of the as_range are incorporated into
  1024.  * an anonymous subtype (slice_index_type). The N_AST2 of the as_slice node 
  1025.  * points to a new name node with this slice_index_type as its N_UNQ. As a
  1026.  * conseqeunce of this reformatting the bounds nodes are no longer connected
  1027.  * to the tree rooted by the as_slice node and are left out when tranversing
  1028.  * the tree in instantiate_tree. Threfore, a special check is made in this
  1029.  * case to instantiate the bound nodes as well.
  1030.  */
  1031.     if ((nkind == as_slice) && (N_KIND(N_AST2(node)) == as_simple_name)) {
  1032.         tup = SIGNATURE(N_UNQ(N_AST2(node)));
  1033.         nnode = instantiate_tree((Node)numeric_constraint_low(tup),rename_map);
  1034.         nnode = instantiate_tree((Node)numeric_constraint_high(tup),rename_map);
  1035.     }
  1036.     nodemap_put(node_map, node, root);
  1037.     return root;
  1038. }
  1039.  
  1040. static int check_recursive_instance(Node node)    /*;check_recursive_instance*/
  1041. {
  1042.     /* Verify that an instance appearing in the current instantiation does
  1043.      * not include an  instantiation of the     unit being instantiated. we
  1044.      * use current_instances to keep track of units already seen.
  1045.      */
  1046.  
  1047.     Node    specs_node, priv_node, body_node;
  1048.     Node    gen_node;
  1049.     Symbol    nam;
  1050.     int        nat;
  1051.     Tuple    sig;
  1052.     Node    body;
  1053.  
  1054.     gen_node = N_AST2(node);
  1055.     nam = N_UNQ(gen_node);
  1056.     if (tup_memsym(nam, current_instances)) {
  1057.         errmsg("Invalid recursive instantiation", "12.3", current_node);
  1058.         return TRUE;
  1059.     }
  1060.     else {
  1061.         current_instances = tup_with(current_instances, (char *) nam );
  1062.         nat = NATURE(nam);
  1063.         if (nat == na_generic_procedure || nat == na_generic_function) {
  1064.             sig = SIGNATURE(nam);
  1065.             body = (Node) sig[3];
  1066.             if (scan_instance(body)) return TRUE;
  1067.         }
  1068.         else if (nat == na_generic_package_spec) {
  1069.             sig = SIGNATURE(nam);
  1070.             specs_node = (Node)sig[2];
  1071.             priv_node = (Node) sig[3];
  1072.             if (scan_instance(specs_node)) return TRUE;
  1073.             if (scan_instance(priv_node)) return TRUE;
  1074.         }
  1075.         else if (nat == na_generic_package) {
  1076.             sig = SIGNATURE(nam);
  1077.             specs_node = (Node) sig[2];
  1078.             priv_node = (Node) sig[3];
  1079.             body_node = (Node) sig[4];
  1080.             if (scan_instance(specs_node)) return TRUE;
  1081.             if (scan_instance(priv_node)) return TRUE;
  1082.             if (scan_instance(body_node)) return TRUE;
  1083.         }
  1084.         nam = (Symbol) tup_frome(current_instances );
  1085.     }
  1086.     return FALSE;
  1087. }
  1088.  
  1089. static int scan_instance(Node node)                     /*;scan_instance */
  1090. {
  1091.     /* Subsidiary procedure to  the above:    search the specs or body of a
  1092.      * generic  object, for the presence  of forward instantiations, i.e.
  1093.      * instantiations that preceded the body of the     generic. Non-trivial
  1094.      * recursive instantiations  can only  occur in the presence of such.
  1095.      */
  1096.  
  1097.     int    i, nkind;
  1098.     Fortup    ft1;
  1099.     Node    inode;
  1100.  
  1101.     if ( N_KIND(node) == as_function_instance
  1102.       || N_KIND(node) == as_procedure_instance 
  1103.       || N_KIND(node) == as_package_instance)
  1104.         if (check_recursive_instance(node)) return TRUE;
  1105.     else {
  1106.         nkind = N_KIND(node);
  1107.         for (i = 1; i <= 4; i++) {
  1108.             inode = (Node)0;
  1109.             if (i == 1 && N_AST1_DEFINED(nkind)) inode = N_AST1(node);
  1110.             else if (i == 2 && N_AST2_DEFINED(nkind)) inode = N_AST2(node);
  1111.             else if (i == 3 && N_AST3_DEFINED(nkind)) inode = N_AST3(node);
  1112.             else if (i == 4 && N_AST4_DEFINED(nkind)) inode = N_AST4(node);
  1113.             if (inode != (Node)0)
  1114.                 if (scan_instance(inode)) return TRUE;
  1115.         }
  1116.         if (N_LIST_DEFINED(nkind) && N_LIST(node) != (Tuple)0) {
  1117.             FORTUP(inode=(Node), N_LIST(node), ft1);
  1118.                 if (scan_instance(inode)) return TRUE;
  1119.             ENDFORTUP(ft1);
  1120.         }
  1121.     }
  1122.     return FALSE;
  1123. }
  1124.  
  1125. Symbol replace(Symbol expn, Symbolmap mapping)        /*;replace*/
  1126. {
  1127.     Symbol sym;
  1128.  
  1129.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  replace");
  1130.  
  1131.     sym = symbolmap_get(mapping, expn);
  1132.     if (sym != (Symbol)0)
  1133.         return sym;
  1134.     else return expn;
  1135. }
  1136.  
  1137. Symbolmap symbolmap_new()        /*;symbolmap_new*/
  1138. {
  1139.     /* initialize symbolmap for n entries */
  1140.  
  1141.     Symbolmap    smap;
  1142.  
  1143.     smap = (Symbolmap) emalloct(sizeof(struct Symbolmap_s), "symbolmap-new");
  1144.     smap->symbolmap_tuple = tup_new(0);
  1145.     return smap;
  1146. }
  1147.  
  1148. Symbol symbolmap_get(Symbolmap type_map, Symbol sym)    /*;symbolmap_get*/
  1149. {
  1150.     int    i, n;
  1151.     Tuple    tup;
  1152.  
  1153.     tup = type_map->symbolmap_tuple;
  1154.     n = tup_size(tup);
  1155.     for (i = 1; i <= n; i+=2)
  1156.         if (tup[i] == (char *)sym)
  1157.             return (Symbol) tup[i+1];
  1158.     /* symbolmap_get returns (Symbol)0 if map undefined */
  1159.     return (Symbol) 0;
  1160. }
  1161.  
  1162. void symbolmap_put(Symbolmap type_map, Symbol symd, Symbol symv)
  1163.   /*;symbolmap_put*/
  1164. {
  1165.     int    i, n;
  1166.     Tuple    tup;
  1167.  
  1168.     tup = type_map->symbolmap_tuple;
  1169.     n = tup_size(tup);
  1170.     for (i = 1; i <= n; i+=2) {
  1171.         if (tup[i] == (char *)symd) {
  1172.             tup[i+1] = (char *)symv;
  1173.             return;
  1174.         }
  1175.     }
  1176.     /* here if need to extend map. */
  1177.     tup = tup_exp(tup, (unsigned) (n+2));
  1178.     type_map->symbolmap_tuple = tup;
  1179.     tup[n+1] = (char *)symd;
  1180.     tup[n+2] = (char *)symv;
  1181.     return;
  1182. }
  1183.  
  1184. Nodemap nodemap_new()                                    /*;nodemap_new*/
  1185. {
  1186.     /* initialize nodemap for n entries */
  1187.  
  1188.     Nodemap    nmap;
  1189.  
  1190.     nmap = (Nodemap) emalloct(sizeof(struct Nodemap_s), "nodemap-new");
  1191.     nmap->nodemap_tuple = tup_new(0);
  1192.     return nmap;
  1193. }
  1194.  
  1195. static void nodemap_free(Nodemap smap)        /*;nodemap_free*/
  1196. {
  1197.     tup_free(smap->nodemap_tuple);
  1198.     efreet((char *) smap, "node-map-free");
  1199. }
  1200.  
  1201. static Node nodemap_get(Nodemap node_map, Node sym)    /*;nodemap_get*/
  1202. {
  1203.     int    i, n;
  1204.     Tuple    tup;
  1205.  
  1206.     tup = node_map->nodemap_tuple;
  1207.     n = tup_size(tup);
  1208.     for (i = 1; i <= n; i+=2)
  1209.         if (tup[i] == (char *)sym)
  1210.             return (Node) tup[i+1];
  1211.     return (Node)0;
  1212. }
  1213.  
  1214. static void nodemap_put(Nodemap node_map, Node symd, Node symv) /*;nodemap_put*/
  1215. {
  1216.     int    i, n;
  1217.     Tuple    tup;
  1218.  
  1219.     tup = node_map->nodemap_tuple;
  1220.     n = tup_size(tup);
  1221.     for (i = 1; i <= n; i+=2) {
  1222.         if (tup[i] == (char *)symd) {
  1223.             tup[i+1] = (char *)symv;
  1224.             return;
  1225.         }
  1226.     }
  1227.     /* here if need to extend map. */
  1228.     tup = tup_exp(tup, (unsigned) n+2);
  1229.     node_map->nodemap_tuple = tup;
  1230.     tup[n+1] = (char *)symd;
  1231.     tup[n+2] = (char *)symv;
  1232.     return;
  1233. }
  1234.